home *** CD-ROM | disk | FTP | other *** search
/ Business Heaven / Business Heaven.iso / accnting / sas56t / files.cla < prev    next >
Text File  |  1993-08-30  |  60KB  |  1,535 lines
  1. SAS          PROGRAM
  2.  
  3. REJECT_KEY   EQUATE(CTRL_ESC)
  4. ACCEPT_KEY   EQUATE(CTRL_ENTER)
  5. TRUE         EQUATE(1)
  6. FALSE        EQUATE(0)
  7.  
  8. !---------------- Eckenroed & Associates 07-90 -----------------------
  9. !
  10. !   This model has been modified for the REPORT3 LEM.  Make sure
  11. !   you have the following .BIN files in the current directory:
  12. !     - INT.BIN
  13. !     - REPORT3.BIN
  14. !
  15. !   All changes have been marked with '####'.
  16. !
  17. !---------------------------------------------------------------------
  18.              MAP
  19.                PROC(G_OPENFILES)
  20.                MODULE('SAS001')
  21.                  PROC(MAIN_MENU)                 !* T H E   M A I N   M E N U *
  22.                .
  23.                MODULE('SAS002')
  24.                  PROC(VIEW_INV)                  !Inventory Directory Table
  25.                .
  26.                MODULE('SAS003')
  27.                  PROC(UPDATE_ITEMS)              !Add Items To An Order
  28.                .
  29.                MODULE('SAS004')
  30.                  PROC(ORDER_ENTRY)               !Order Entry
  31.                .
  32.                MODULE('SAS005')
  33.                  PROC(EDIT_PRICE)                !Procedure To Edit Order Price
  34.                .
  35.                MODULE('SAS006')
  36.                  PROC(VIEW_CLI)                  !View Client Table
  37.                .
  38.                MODULE('SAS007')
  39.                  PROC(ADD_ORDERS)                !Add a New Order
  40.                .
  41.                MODULE('SAS008')
  42.                  PROC(PRINT_ORDER)               !Print Current Order (Invoice)
  43.                .
  44.                MODULE('SAS009')
  45.                  PROC(VIEW_ORDS)                 !View Current Orders
  46.                .
  47.                MODULE('SAS010')
  48.                  PROC(MENU_UTILS)                !Menu Utilities
  49.                .
  50.                MODULE('SAS011')
  51.                  PROC(PICK_VENDORS)              !Pick a Vendor
  52.                .
  53.                MODULE('SAS012')
  54.                  PROC(REPORT_MENU)               !Report Generation Menu
  55.                .
  56.                MODULE('SAS013')
  57.                  PROC(PRINT_CLIENT)              !Print the Client List
  58.                .
  59.                MODULE('SAS014')
  60.                  PROC(PRINT_CLASS1)              !Print Price List (Class 1)
  61.                .
  62.                MODULE('SAS015')
  63.                  PROC(PRINT_CLASS2)              !Print Price List (Class 2)
  64.                .
  65.                MODULE('SAS016')
  66.                  PROC(PRINT_INVNTY)              !Print Entire Inventory
  67.                .
  68.                MODULE('SAS017')
  69.                  PROC(PRINT_VENDOR)              !Print Vendor List
  70.                .
  71.                MODULE('SAS018')
  72.                  PROC(PRINT_TICKET)              !Print Order Ticket
  73.                .
  74.                MODULE('SAS019')
  75.                  PROC(VIEW_METHODS)              !View Payment Methods
  76.                .
  77.                MODULE('SAS020')
  78.                  PROC(EDIT_METHODS)              !Edit Payment Methods
  79.                .
  80.                MODULE('SAS021')
  81.                  PROC(VIEW_TERMS)                !View Payment Terms
  82.                .
  83.                MODULE('SAS022')
  84.                  PROC(EDIT_TERMS)                !Edit Payment Terms
  85.                .
  86.                MODULE('SAS023')
  87.                  PROC(VIEW_VENDORS)              !View Vendor List
  88.                .
  89.                MODULE('SAS024')
  90.                  PROC(UPD_CLI)                   !Update Client Information
  91.                .
  92.                MODULE('SAS025')
  93.                  PROC(SHOW_COST)                 !Show Cost and Profit
  94.                .
  95.                MODULE('SAS026')
  96.                  PROC(UPD_COMPANY)               !Update Company Information
  97.                .
  98.                MODULE('SAS027')
  99.                  PROC(VIEW_COMENTS)              !View Comments
  100.                .
  101.                MODULE('SAS028')
  102.                  PROC(PICK_ITEM)                 !Current Items Table
  103.                .
  104.                MODULE('SAS029')
  105.                  PROC(GET_DETAIL)                !Get Final Order Detail
  106.                .
  107.                MODULE('SAS030')
  108.                  PROC(EDIT_VENDORS)              !Edit Vendors
  109.                .
  110.                MODULE('SAS031')
  111.                  PROC(LIST_CLI)                  !List Clients
  112.                .
  113.                MODULE('SAS032')
  114.                  PROC(PRINT_CLASS3)              !Print Price List (Class 3)
  115.                .
  116.                MODULE('SAS033')
  117.                  PROC(UPD_INV)                   !Inventory Update Form
  118.                .
  119.                MODULE('SAS034')
  120.                  PROC(VIEW_CLI_VEN)
  121.                .
  122.                MODULE('SAS035')
  123.                  PROC(VIEW_VEN_NUM)              !View Vendor List
  124.                .
  125.                MODULE('SAS036')
  126.                  PROC(VIEW_NOTES)                !View Notes
  127.                .
  128.                MODULE('SAS037')
  129.                  PROC(PRINT_ORDERE)              !Print Current Order (Invoice)
  130.                .
  131.                MODULE('SAS038')
  132.                  PROC(PRINT_TICKEE)              !Print Order Ticket
  133.                .
  134.                MODULE('SAS039')
  135.                  PROC(CLIENT_LAB)                !Client Mailing Labels
  136.                .
  137.                MODULE('SAS040')
  138.                  PROC(VIEW_QUANT)
  139.                .
  140.                MODULE('SAS041')
  141.                  PROC(UPD_QUANTITY)
  142.                .
  143.                MODULE('SAS042')
  144.                  PROC(PAST_INVOICE)              !Past Invoice Table
  145.                .
  146.                MODULE('SAS043')
  147.                  PROC(VIEW_PAST)                 !View Past Orders
  148.                .
  149.                MODULE('SAS044')
  150.                  PROC(SHOW_DETAIL)               !Show Final Order Detail
  151.                .
  152.                MODULE('SAS045')
  153.                  PROC(INVENTORY)                 !Inventory Quantity Updates
  154.                .
  155.                MODULE('SAS046')
  156.                  PROC(UPD_QUANT)
  157.                .
  158.                MODULE('SAS047')
  159.                  PROC(INV_RPT_MNU)               !Inventory Report Menu
  160.                .
  161.                MODULE('SAS048')
  162.                  PROC(SLS_RPT_MNU)               !Sales Report Menu
  163.                .
  164.                MODULE('SAS049')
  165.                  PROC(CLI_RPT_MNU)               !Client Report Menu
  166.                .
  167.                MODULE('SAS050')
  168.                  PROC(VEN_RPT_MNU)               !Vendor Report List
  169.                .
  170.                MODULE('SAS051')
  171.                  PROC(LABELS)                    !Mail Labels Explained
  172.                .
  173.                MODULE('SAS052')
  174.                  PROC(VENDOR_LAB)                !Vendor Mailing Labels
  175.                .
  176.                MODULE('SAS053')
  177.                  PROC(QUOTE_BY_SLS)              !Outstanding Quotes by Salepers
  178.                .
  179.                MODULE('SAS054')
  180.                  PROC(VIEW_SALESP)               !View Salespersons
  181.                .
  182.                MODULE('SAS055')
  183.                  PROC(UPD_SALESP)                !Update Salespersons
  184.                .
  185.                MODULE('SAS056')
  186.                  PROC(SUM_Q_SALES)               !Sum Sales Quotation Data
  187.                .
  188.                MODULE('SAS057')
  189.                  PROC(QUOTE_ALL)                 !Outstanding Quotes
  190.                .
  191.                MODULE('SAS058')
  192.                  PROC(SUM_Q_ALL)                 !Sum Sales Quotation Data
  193.                .
  194.                MODULE('SAS059')
  195.                  PROC(INV_ALL)
  196.                .
  197.                MODULE('SAS060')
  198.                  PROC(INV_BY_SALES)
  199.                .
  200.                MODULE('SAS061')
  201.                  PROC(TAX_RPT)
  202.                .
  203.                MODULE('SAS062')
  204.                  PROC(INV_BY_CUST)
  205.                .
  206.                MODULE('SAS063')
  207.                  PROC(SUM_I_CUST)                !Sum Sales by Cust Data
  208.                .
  209.                MODULE('SAS064')
  210.                  PROC(PICK_CLI)
  211.                .
  212.                MODULE('SAS065')
  213.                  PROC(SUM_I_ALL)                 !Sum Sales Invoice Data
  214.                .
  215.                MODULE('SAS066')
  216.                  PROC(SUM_I_SALES)               !Sum Sales Invoice Data
  217.                .
  218.                MODULE('SAS067')
  219.                  PROC(BELOW_MIN)                 !Below Minimum Report By Group
  220.                .
  221.                MODULE('SAS068')
  222.                  PROC(BELOW_MIN_VN)              !Below Minimum Report By Vendor
  223.                .
  224.                MODULE('SAS069')
  225.                  PROC(VIEW_COMENT)
  226.                .
  227.                MODULE('SAS070')
  228.                  PROC(PAST_COST)                 !Show Cost and Profit
  229.                .
  230.                MODULE('SAS071')
  231.                  PROC(PRT_CLI_COM)               !Print Client List w/Comment
  232.                .
  233.                MODULE('SAS072')
  234.                  PROC(PRT_VEN_COM)               !Print Vendor List
  235.                .
  236.                MODULE('SAS073')
  237.                  PROC(INVN_VALUE)                !Cost of Inventory
  238.                .
  239.                MODULE('SAS074')
  240.                  PROC(VIEW_GROUP)                !View Inventory By Group
  241.                .
  242.                MODULE('SAS075')
  243.                  PROC(PICK_GROUP)                !View Inventory By Group
  244.                .
  245.                MODULE('SAS076')
  246.                  PROC(DEL_ORDERS)                !Delete Past Invoices
  247.                .
  248.                MODULE('SAS077')
  249.                  PROC(VIEW_PAYMENT)              !View Payments
  250.                .
  251.                MODULE('SAS078')
  252.                  PROC(ADD_PAYMENT)               !Add Payment
  253.                .
  254.                MODULE('SAS079')
  255.                  PROC(AR_OPEN)                   !View AR open Orders
  256.                .
  257.                MODULE('SAS080')
  258.                  PROC(NO_RECORDS)
  259.                .
  260.                MODULE('SAS081')
  261.                  PROC(AR_RPT_MNU)                !AR Report Menu
  262.                .
  263.                MODULE('SAS082')
  264.                  PROC(AR_UNPAID)
  265.                .
  266.                MODULE('SAS083')
  267.                  PROC(CLASS1_QTY)                !Price List - Class 1 w/QTY
  268.                .
  269.                MODULE('SAS084')
  270.                  PROC(CLASS2_QTY)                !Price List - Class 2 w/QTY
  271.                .
  272.                MODULE('SAS085')
  273.                  PROC(CLASS3_QTY)                !Price List - Class 3 w/QTY
  274.                .
  275.                MODULE('SAS086')
  276.                  PROC(COUNT_SHEET1)              !Item Count Sheets By Part#
  277.                .
  278.                MODULE('SAS087')
  279.                  PROC(COUNT_SHEET2)              !Item Count Sheets By Group
  280.                .
  281.                MODULE('SAS088')
  282.                  PROC(CATALOG)                   !Catalog List
  283.                .
  284.                MODULE('SAS089')
  285.                  PROC(CLIENT_STMNT)
  286.                .
  287.                MODULE('SAS090')
  288.                  PROC(PICK_CLI_FRM)
  289.                .
  290.                MODULE('SAS091')
  291.                  PROC(ALL_STMNT)
  292.                .
  293.                MODULE('SAS092')
  294.                  PROC(ABOUT_SAS)                 !About SAS Screen
  295.                .
  296.                MODULE('SAS093')
  297.                  PROC(PICK_CLIENT)
  298.                .
  299.                MODULE('SAS094')
  300.                  PROC(PRT_CLI_HIST)              !Client Purchasing History
  301.                .
  302.                MODULE('SAS095')
  303.                  PROC(OPEN_SCR)                  !OPENING SCREEN
  304.                .
  305.                MODULE('SAS096')
  306.                  PROC(PRINTORDMENU)              !PRINT ORDER MENU
  307.                .
  308.                MODULE('SAS097')
  309.                  PROC(PRINT_LABEL)
  310.                .
  311.                MODULE('SAS098')
  312.                  PROC(PRINT_ENVLOP)
  313.                .
  314.                MODULE('SAS099')
  315.                  PROC(PO_ENTRY)                  !Purchase Order Entry
  316.                .
  317.                MODULE('SAS100')
  318.                  PROC(NO_PRODUCT)
  319.                .
  320.                MODULE('SAS101')
  321.                  PROC(VIEW_PURCHS)
  322.                .
  323.                MODULE('SAS102')
  324.                  PROC(ADD_PURCH)
  325.                .
  326.                MODULE('SAS103')
  327.                  PROC(PO_WARN)
  328.                .
  329.                MODULE('SAS104')
  330.                  PROC(CLI_REP_1LN)               !Client List
  331.                .
  332.                MODULE('SAS105')
  333.                  PROC(UPDATE_ITP)                !Add Items To An PO Order
  334.                .
  335.                MODULE('SAS106')
  336.                  PROC(PRINT_PACK)                !Print Packing List
  337.                .
  338.                MODULE('SAS107')
  339.                  PROC(PICK_ORD)                  !View Current Orders
  340.                .
  341.                MODULE('SAS108')
  342.                  PROC(PUR_RPT_MNU)               !AR Report Menu
  343.                .
  344.                MODULE('SAS109')
  345.                  PROC(PUR_ORD_RPT)               !Purchase Order Report
  346.                .
  347.                MODULE('SAS110')
  348.                  PROC(PUR_OPEN_RPT)              !Summary of Open Purchase Order
  349.                .
  350.                MODULE('SAS111')
  351.                  PROC(PUR_BACK_RPT)              !Backorder Report
  352.                .
  353.                MODULE('SAS112')
  354.                  PROC(LOOKUP_PO)
  355.                .
  356.                MODULE('SAS113')
  357.                  PROC(MAIN_SCR)                  !Opening Screen
  358.                .
  359.                MODULE('MYCODE')
  360.                  PROC(PACKDATA)                  !Pack Data Files
  361.                  PROC(PRINT_ORDHOW)
  362.                  PROC(PRINT_TICHOW)
  363.                  PROC(ADJUST_INV)
  364.                  PROC(MASS_UPDATE)               !MASS Update
  365.                  PROC(TAX_UPDATE)                !Mass Update Client Tax Rate
  366.                  PROC(ADJ_INV_PO)
  367.                  PROC(COPY_ORD)                  !COPY ORDER
  368.                  PROC(BACK_ORD)                  !MARK AS BACKORDERED ITEM
  369.                  PROC(PO_TRANS_ALL)              !MOVE ALL PO ITEMS TO INVENTORY
  370.                  PROC(INV_QUOTE)                 !Convert Invoice back to Quote
  371.                  PROC(INV_QTE_INV)               !Invoice > Quote Inventory upd
  372.                .
  373.              .
  374.              EJECT('FILE LAYOUTS')
  375. CLIENTS      FILE,PRE(CLI),CREATE,RECLAIM
  376. CLIENT_KEY     KEY(CLI:CLIENT),DUP,NOCASE,OPT
  377. CLI_NO_KEY     KEY(CLI:CLIENT_NO),NOCASE,OPT
  378. ZIP_KEY        KEY(CLI:ZIP),DUP,NOCASE,OPT
  379. COMMENTS       MEMO(490)                         !Comments
  380. RECORD         RECORD
  381. CLIENT_NO        LONG                            !CLIENT NUMBER
  382. CLIENT           STRING(32)                      !Client Name
  383. ORDEREDBY        STRING(32)                      !Ordered By
  384. ADD1             STRING(32)                      !Address #1
  385. ADD2             STRING(32)                      !Address #2
  386. CITY             STRING(17)                      !City
  387. STATE            STRING(3)                       !State
  388. ZIP              STRING(10)                      !Zip Code
  389. DAYPHONE         DECIMAL(10,0)                   !Day Phone
  390. EXTENSION        STRING(10)                      !Extension
  391. EVEPHONE         DECIMAL(10,0)                   !Eve Phone
  392. FAXPHONE         DECIMAL(10,0)                   !Fax Phone
  393. PRICECLASS       BYTE                            !Price Class
  394. TAXPCT           REAL                            !Sales Tax Percentage
  395. CREDITLIMIT      REAL                            !Credit Limit
  396. ROUTE            LONG                            !delivery route
  397.              . .
  398.              GROUP,OVER(CLI:COMMENTS)
  399. CLI_MEMO_ROW   STRING(70),DIM(7)
  400.              .
  401.  
  402. INVNTORY     FILE,PRE(INV),CREATE,RECLAIM
  403. BY_GROUP       KEY(INV:GROUPNAME,INV:PARTNUM),NOCASE,OPT
  404. BY_PARTNUM     KEY(INV:PARTNUM),NOCASE,OPT
  405. BY_VENDOR      KEY(INV:VENDOR,INV:GROUPNAME,INV:PARTNUM),DUP,NOCASE,OPT
  406. BY_LOCATION    KEY(INV:LOCATION,INV:GROUPNAME,INV:PARTNUM),DUP,NOCASE,OPT
  407. BY_GROUP_PRC   KEY(INV:GROUPNAME,INV:CLASS1,INV:PARTNUM),DUP,NOCASE,OPT
  408. COMMENTS       MEMO(108)                         !Printable Comments
  409. RECORD         RECORD
  410. PARTNUM          STRING(20)                      !Part Number
  411. GROUPNAME        STRING(25)                      !Group Name
  412. PRODDESC         STRING(35)                      !Product Description
  413. COST             REAL                            !Item Cost
  414. MFGRETAIL        REAL                            !MFG Retail Price
  415. CLASS1           REAL                            !Price Class 1
  416. CLASS2           REAL                            !Price Class 2
  417. CLASS3           REAL                            !Price Class 3
  418. STOCK_ADJUST     STRING(3)                       !Adjust Stock on Sold Items?
  419. TAXABLE          STRING(3)                       !Taxable Flag
  420. VENDOR           STRING(32)                      !Vendor Name
  421. NOTES1           STRING(27)                      !Non-Print #1
  422. NOTES2           STRING(27)
  423. NOTES3           STRING(27)
  424. NOTES4           STRING(27)
  425. PROD_SIZE        DECIMAL(5,1)                    !SIZE OF ITEM/PRODUCT
  426. PROD_WEIGHT      DECIMAL(7,2)                    !WEIGHT IN LBS.
  427. LOCATION         LONG                            !LOCATION
  428. ON_HAND          REAL                            !Qty On Hand
  429. ON_ORDER         REAL                            !Qty On Order
  430. MIN_QTY          REAL                            !Minimum Quantity
  431.              . .
  432.              GROUP,OVER(INV:COMMENTS)
  433. INV_MEMO_ROW   STRING(27),DIM(4)
  434.              .
  435.  
  436. ORDERS       FILE,PRE(ORD),CREATE,RECLAIM
  437. ORDER_KEY      KEY(ORD:ORDER_NUM),NOCASE,OPT
  438. TYPE_KEY       KEY(ORD:TYPE,ORD:CLIENT,ORD:DATE),DUP,NOCASE,OPT
  439. TYPE_DATE      KEY(ORD:TYPE,ORD:DATE),DUP,NOCASE,OPT
  440. OPEN_KEY       KEY(ORD:OPEN,ORD:CLIENT),DUP,OPT
  441. ORD_CLI_KEY    KEY(ORD:CLIENT,ORD:DATE),DUP,NOCASE,OPT
  442. NOTES          MEMO(105)                         !Order Notes
  443. RECORD         RECORD
  444. ORDER_NUM        LONG                            !Order Number
  445. INVOICE_NUM      LONG                            !Invoice #
  446. INV_ADJUSTED     STRING(1)                       !Inventory Adjusted?
  447. CLIENT           STRING(32)                      !Client Name
  448. CLIENT_NO        LONG
  449. TYPE             STRING(9)                       !Order Type
  450. DATE             LONG                            !Order Date
  451. SALESPERSON      STRING(32)                      !Salesperson
  452. ORDERREF         STRING(28)                      !Order Reference
  453. PO               STRING(25)                      !CLIENT PURCHASE ORDER NUMBER
  454. PRICECLASS       BYTE                            !Price Class
  455. TAXPCT           REAL                            !Tax Percentage
  456. TAX              REAL                            !Tax on Order
  457. PAYMETHOD        STRING(20)                      !Method of Payment
  458. TERMS            STRING(13)                      !Payment Terms
  459. CCNUM            STRING(25)                      !Credit Card Number
  460. EXPDATE          STRING(10)                      !Credit Card Expiration Date
  461. AUTHORIZE        STRING(12)                      !CC Authorization
  462. SHIPTO           STRING(32)                      !Ship To - Name
  463. SHIPADD1         STRING(32)                      !Ship To - Address #1
  464. SHIPADD2         STRING(32)                      !Ship To - Address #2
  465. SHIPCITY         STRING(17)                      !Ship To - City
  466. SHIPSTATE        STRING(3)                       !Ship To - State
  467. SHIPZIP          STRING(10)                      !Ship To - Zip Code
  468. SHIPATTN         STRING(26)                      !Ship To - Attention
  469. SHIP_TRACK       STRING(25)                      !TRACKING NUMBER FOR UPS/FED_X
  470. SHIP_AMT         REAL                            !SHIPPING COSTS
  471. OTHER_AMT        REAL                            !MISC CHARGES- CUSTOM
  472. COD_AMT          REAL
  473. COST             REAL                            !Order Cost
  474. SUBTOTAL         REAL                            !Order Subtotal
  475. TOTAL            REAL                            !Order Total
  476. PAYMENTS         REAL                            !Payments
  477. BALANCE          REAL                            !Balance Due
  478. OPEN             STRING(4)                       !Order Open?
  479. TAXABLE          REAL
  480.              . .
  481.              GROUP,OVER(ORD:NOTES)
  482. ORD_MEMO_ROW   STRING(35),DIM(3)
  483.              .
  484.  
  485. ITEM_ORD     FILE,PRE(ITE),CREATE
  486. ORD_KEY        KEY(ITE:ORDER_NUM),DUP,NOCASE,OPT
  487. PRC_ORD_KEY    KEY(ITE:ORDER_NUM,ITE:ORDERPRICE),DUP,NOCASE,OPT
  488. PICK_LST_KEY   KEY(ITE:LOCATION,ITE:CLIENT_NO,ITE:DATE),DUP,NOCASE,OPT
  489. PICK_LST_K2    KEY(ITE:LOCATION,ITE:PART_NUM),DUP,NOCASE,OPT
  490. RECORD         RECORD
  491. ORDER_NUM        LONG                            !Order Number
  492. PART_NUM         STRING(20)                      !Part Number
  493. CLIENT_NO        LONG
  494. DATE             LONG
  495. QTY              LONG                            !Quantity
  496. UNITCOST         REAL                            !Unit Cost
  497. PRODDESC         STRING(35)                      !Product Description
  498. LOCATION         LONG
  499. PROD_SIZE        DECIMAL(4,1)
  500. SERIAL_NUM       STRING(35)                      !SERIAL NUMBERS
  501. ORDERPRICE       REAL                            !Order Price
  502.              . .
  503.  
  504. PURC_ORD     FILE,PRE(PUR),CREATE,RECLAIM
  505. PO_KEY         KEY(PUR:PO_NUM),NOCASE,OPT
  506. PO_OPEN        KEY(PUR:OPEN,PUR:PO_NUM),DUP,NOCASE,OPT
  507. PO_REFERNCE    KEY(PUR:ORDERREF),NOCASE,OPT
  508. PO_STATUS      KEY(PUR:OPEN,PUR:DATE),DUP,NOCASE,OPT
  509. NOTES          MEMO(105)                         !Order Notes
  510. RECORD         RECORD
  511. PO_NUM           LONG                            !PO Number
  512. DATE             LONG                            !Order Date
  513. ORDERREF         STRING(28)                      !Order Reference
  514. SHIPPING         REAL
  515. TOTAL            REAL                            !Order Total
  516. OPEN             STRING(4)                       !Order Open?
  517.              . .
  518.              GROUP,OVER(PUR:NOTES)
  519. PUR_MEMO_ROW   STRING(35),DIM(3)
  520.              .
  521.  
  522. ITEM_PO      FILE,PRE(ITP),CREATE
  523. ORD_KEY        KEY(ITP:PO_NUM,ITP:INV_STATUS,ITP:PART_NUM),DUP,NOCASE,OPT
  524. ITP_PO_KEY     KEY(ITP:PO_NUM),DUP,NOCASE,OPT
  525. RECORD         RECORD
  526. PO_NUM           LONG                            !PURCHASE ORDER NUMBER
  527. INV_STATUS       STRING(1)                       !Y-ADJUSTED,N-ORDERED,B-BACKORD
  528. PART_NUM         STRING(20)                      !Part Number
  529. DATE             LONG
  530. QTY              LONG                            !Quantity
  531. PRODDESC         STRING(35)                      !Product Description
  532. UNITCOST         REAL                            !Unit Cost
  533. ORDERPRICE       REAL                            !Order Price
  534.              . .
  535.  
  536. PAYMETHD     FILE,PRE(PAY),CREATE,RECLAIM
  537. METHOD_KEY     KEY(PAY:METHOD_PAY),NOCASE,OPT
  538. RECORD         RECORD
  539. METHOD_PAY       STRING(20)                      !Method Of Payment
  540. TYPE             STRING(8)                       !type of payment
  541.              . .
  542.  
  543. TERMS        FILE,PRE(TER),CREATE,RECLAIM
  544. TERM_KEY       KEY(TER:TERMS),NOCASE,OPT
  545. RECORD         RECORD
  546. TERMS            STRING(13)                      !Terms of Order
  547.              . .
  548.  
  549. VENDORS      FILE,PRE(VEN),CREATE,RECLAIM
  550. VEN_KEY        KEY(VEN:VENDOR),DUP,NOCASE,OPT
  551. VEN_NUM_KEY    KEY(VEN:VENDOR_NUM),NOCASE,OPT
  552. ZIP_KEY        KEY(VEN:ZIP),DUP,NOCASE,OPT
  553. COMMENTS       MEMO(350)                         !Comments
  554. RECORD         RECORD
  555. VENDOR_NUM       LONG
  556. VENDOR           STRING(40)                      !Vendor Name
  557. ADD1             STRING(32)                      !Address #1
  558. ADD2             STRING(32)                      !Address #2
  559. CITY             STRING(17)                      !City
  560. STATE            STRING(3)                       !State
  561. ZIP              STRING(10)                      !Zip Code
  562. CONTACT          STRING(32)                      !Contact Person
  563. DAYPHONE         DECIMAL(10,0)                   !Phone Number
  564. EXTENSION        STRING(10)                      !Extension
  565. EVEPHONE         DECIMAL(10,0)                   !Phone Number #2
  566. FAXPHONE         DECIMAL(10,0)                   !Fax Phone Number
  567. ACCTNUM          STRING(20)                      !Account Number
  568. TERMS            STRING(32)                      !Terms
  569.              . .
  570.              GROUP,OVER(VEN:COMMENTS)
  571. VEN_MEMO_ROW   STRING(70),DIM(5)
  572.              .
  573.  
  574. SALESPER     FILE,PRE(SAL),CREATE,RECLAIM
  575. SALES_KEY      KEY(SAL:SALESPERSON),NOCASE,OPT
  576. RECORD         RECORD
  577. SALESPERSON      STRING(32)                      !Salesperson Name
  578.              . .
  579.  
  580. PAYMENTS     FILE,PRE(PMT),CREATE,RECLAIM
  581. ORDER_KEY      KEY(PMT:ORDER_NUM),DUP,NOCASE,OPT
  582. INVOICE_KEY    KEY(PMT:INVOICE_NUM),DUP,NOCASE,OPT
  583. CLIENT_KEY     KEY(PMT:CLIENT),DUP,NOCASE,OPT
  584. DATE_KEY       KEY(PMT:DATE),DUP,NOCASE,OPT
  585. CLI_DATE_KEY   KEY(PMT:CLIENT_NO,PMT:DATE),DUP,NOCASE,OPT
  586. RECORD         RECORD
  587. ORDER_NUM        LONG                            !Order Number
  588. INVOICE_NUM      LONG                            !Invoice Number
  589. CLIENT           STRING(32)                      !Client Name
  590. CLIENT_NO        LONG                            !CLIENT NUMBER
  591. DATE             LONG                            !Deposit Date
  592. REFERENCE        STRING(15)                      !Deposit Reference
  593. PAYMENT          REAL                            !Payment Paid
  594.              . .
  595.  
  596.              EJECT('GLOBAL MEMORY VARIABLES')
  597. ACTION       SHORT                               !0 = NO ACTION
  598.                                                  !1 = ADD RECORD
  599.                                                  !2 = CHANGE RECORD
  600.                                                  !3 = DELETE RECORD
  601.                                                  !4 = LOOKUP FIELD
  602.                                                  !5 = AUTONUMKEY ADD
  603.  
  604. ascii_tmp    dos,ascii,name(mem:device)          !#### Eckenroed & Associates
  605.              record                              !#### Eckenroed & Associates
  606.              string(1)                           !#### Eckenroed & Associates
  607.              . .                                 !#### Eckenroed & Associates
  608.  
  609.              GROUP,PRE(MEM)
  610. MESSAGE        STRING(30)                        !Global Message Area
  611. DUMMY          STRING(1)                         !Dummy Field
  612. DUMMY2         STRING(1)                         !Dummy Field
  613. PAGE           SHORT                             !Report Page Number
  614. LINE           SHORT                             !Report Line Number
  615. DEVICE         STRING(30)                        !Report Device
  616. COST           REAL                              !Temporary hold - system cost
  617. SUBTOTAL       REAL                              !Temporary hold - system total
  618. TAX            REAL                              !Order Tax
  619. SHIP_AMT       REAL                              !SHIPPING CHAGES
  620. TAXABLE        REAL                              !Taxable Total
  621. TOTAL          REAL                              !Order Total
  622. DEPOSIT        REAL                              !Order Deposit
  623. PAYMENTS       REAL                              !Order Payments
  624. BALANCE        REAL                              !Balance Due
  625. OPEN           STRING(4)                         !Open Invoice?
  626. BEGDATE        LONG                              !Beginning Date
  627. ENDDATE        LONG                              !Ending Date
  628. CLIENT         STRING(32)                        !Client Name
  629. SALESPERSON    STRING(32)
  630. START_NUM      LONG
  631. END_NUM        LONG(9999)
  632. START_DATE     LONG
  633. END_DATE       LONG
  634. CLIENTS        STRING(30)                        !TEMP RANDOM CLIENTS FOR REPORT
  635.              .
  636.  
  637.              EJECT('CODE SECTION')
  638.   CODE
  639.   LOOP                                           !#### Eckenroed & Associates
  640.       mem:device = 'RP3'             |           !#### Eckenroed & Associates
  641.                  & RANDOM(1000,9999) |           !#### Eckenroed & Associates
  642.                  & '.TMP'                        !#### Eckenroed & Associates
  643.       open(ascii_tmp)                            !#### Eckenroed & Associates
  644.       if errorcode() = 2                         !#### Eckenroed & Associates
  645.           close(ascii_tmp)                       !#### Eckenroed & Associates
  646.           break                                  !#### Eckenroed & Associates
  647.       .                                          !#### Eckenroed & Associates
  648.       close(ascii_tmp)                           !#### Eckenroed & Associates
  649.   .                                              !#### Eckenroed & Associates
  650.  
  651.   SETHUE(7,0)                                    !SET WHITE ON BLACK
  652.   BLANK                                          !  AND BLANK
  653.   HELP('SASHELP.HLP')                            !OPEN THE HELP FILE
  654. ! G_OPENFILES                                    !OPEN OR CREATE FILES
  655.   SETHUE()                                       !    THE SCREEN
  656.   MAIN_MENU                                      !* T H E   M A I N   M E N U *
  657.   RETURN                                         !EXIT TO DOS
  658.  
  659. G_OPENFILES  PROCEDURE                           !OPEN FILES & CHECK FOR ERROR
  660.   CODE
  661.   RECOVER(120)                                   !HOLDS TIMEOUT IN 120 SECONDS
  662.   SHOW(25,1,CENTER('SHARING FILE: ' & 'COMPANY',80))
  663.   IF COM:NETWORKED = 'Y' THEN SHARE(COMPANY) ELSE OPEN(COMPANY).
  664.   IF ERROR()
  665.     CASE ERRORCODE()
  666.     OF 46
  667.       SETHUE(0,7)
  668.       SHOW(25,1,CENTER('REBUILDING KEY FILES FOR COMPANY',80))
  669.       OPEN(COMPANY)
  670.       IF ERROR()
  671.         SHOW(25,1,CENTER('EXCLUSIVE ACCESS REQUIRED TO' |
  672.              & 'REBUILD KEYS FOR COMPANY',80))
  673.         ASK
  674.         RETURN
  675.       ELSE
  676.         BUILD(COMPANY)
  677.         CLOSE(COMPANY)
  678.         SHARE(COMPANY)
  679.         SETHUE(7,0)
  680.         BLANK(25,1,1,80)
  681.       .
  682.     OF 2
  683.       CREATE(COMPANY)
  684.       CLOSE(COMPANY)
  685.       SHARE(COMPANY)
  686.     ELSE
  687.       LOOP
  688.         STOP('Cannot Share COMPANY - Error: ' & ERROR())
  689.       .
  690.   . .
  691.  
  692.   SHOW(25,1,CENTER('SHARING FILE: ' & 'CLIENTS',80))
  693.   SHARE(CLIENTS)
  694.   IF ERROR()
  695.     CASE ERRORCODE()
  696.     OF 46
  697.       SETHUE(0,7)
  698.       SHOW(25,1,CENTER('REBUILDING KEY FILES FOR CLIENTS',80))
  699.       OPEN(CLIENTS)
  700.       IF ERROR()
  701.         SHOW(25,1,CENTER('EXCLUSIVE ACCESS REQUIRED TO' |
  702.              & 'REBUILD KEYS FOR CLIENTS',80))
  703.         ASK
  704.         RETURN
  705.       ELSE
  706.         BUILD(CLIENTS)
  707.         CLOSE(CLIENTS)
  708.         SHARE(CLIENTS)
  709.         SETHUE(7,0)
  710.         BLANK(25,1,1,80)
  711.       .
  712.     OF 2
  713.       CREATE(CLIENTS)
  714.       CLOSE(CLIENTS)
  715.       SHARE(CLIENTS)
  716.     ELSE
  717.       LOOP
  718.         STOP('Cannot Share CLIENTS - Error: ' & ERROR())
  719.       .
  720.   . .
  721.  
  722.   SHOW(25,1,CENTER('SHARING FILE: ' & 'INVNTORY',80))
  723.   SHARE(INVNTORY)
  724.   IF ERROR()
  725.     CASE ERRORCODE()
  726.     OF 46
  727.       SETHUE(0,7)
  728.       SHOW(25,1,CENTER('REBUILDING KEY FILES FOR INVNTORY',80))
  729.       OPEN(INVNTORY)
  730.       IF ERROR()
  731.         SHOW(25,1,CENTER('EXCLUSIVE ACCESS REQUIRED TO' |
  732.              & 'REBUILD KEYS FOR INVNTORY',80))
  733.         ASK
  734.         RETURN
  735.       ELSE
  736.         BUILD(INVNTORY)
  737.         CLOSE(INVNTORY)
  738.         SHARE(INVNTORY)
  739.         SETHUE(7,0)
  740.         BLANK(25,1,1,80)
  741.       .
  742.     OF 2
  743.       CREATE(INVNTORY)
  744.       CLOSE(INVNTORY)
  745.       SHARE(INVNTORY)
  746.     ELSE
  747.       LOOP
  748.         STOP('Cannot Share INVNTORY - Error: ' & ERROR())
  749.       .
  750.   . .
  751.  
  752.   SHOW(25,1,CENTER('SHARING FILE: ' & 'ORDERS',80))
  753.   SHARE(ORDERS)
  754.   IF ERROR()
  755.     CASE ERRORCODE()
  756.     OF 46
  757.       SETHUE(0,7)
  758.       SHOW(25,1,CENTER('REBUILDING KEY FILES FOR ORDERS',80))
  759.       OPEN(ORDERS)
  760.       IF ERROR()
  761.         SHOW(25,1,CENTER('EXCLUSIVE ACCESS REQUIRED TO' |
  762.              & 'REBUILD KEYS FOR ORDERS',80))
  763.         ASK
  764.         RETURN
  765.       ELSE
  766.         BUILD(ORDERS)
  767.         CLOSE(ORDERS)
  768.         SHARE(ORDERS)
  769.         SETHUE(7,0)
  770.         BLANK(25,1,1,80)
  771.       .
  772.     OF 2
  773.       CREATE(ORDERS)
  774.       CLOSE(ORDERS)
  775.       SHARE(ORDERS)
  776.     ELSE
  777.       LOOP
  778.         STOP('Cannot Share ORDERS - Error: ' & ERROR())
  779.       .
  780.   . .
  781.  
  782.   SHOW(25,1,CENTER('SHARING FILE: ' & 'ITEM_ORD',80))
  783.   SHARE(ITEM_ORD)
  784.   IF ERROR()
  785.     CASE ERRORCODE()
  786.     OF 46
  787.       SETHUE(0,7)
  788.       SHOW(25,1,CENTER('REBUILDING KEY FILES FOR ITEM_ORD',80))
  789.       OPEN(ITEM_ORD)
  790.       IF ERROR()
  791.         SHOW(25,1,CENTER('EXCLUSIVE ACCESS REQUIRED TO' |
  792.              & 'REBUILD KEYS FOR ITEM_ORD',80))
  793.         ASK
  794.         RETURN
  795.       ELSE
  796.         BUILD(ITEM_ORD)
  797.         CLOSE(ITEM_ORD)
  798.         SHARE(ITEM_ORD)
  799.         SETHUE(7,0)
  800.         BLANK(25,1,1,80)
  801.       .
  802.     OF 2
  803.       CREATE(ITEM_ORD)
  804.       CLOSE(ITEM_ORD)
  805.       SHARE(ITEM_ORD)
  806.     ELSE
  807.       LOOP
  808.         STOP('Cannot Share ITEM_ORD - Error: ' & ERROR())
  809.       .
  810.   . .
  811.  
  812.   SHOW(25,1,CENTER('SHARING FILE: ' & 'PURC_ORD',80))
  813.   SHARE(PURC_ORD)
  814.   IF ERROR()
  815.     CASE ERRORCODE()
  816.     OF 46
  817.       SETHUE(0,7)
  818.       SHOW(25,1,CENTER('REBUILDING KEY FILES FOR PURC_ORD',80))
  819.       OPEN(PURC_ORD)
  820.       IF ERROR()
  821.         SHOW(25,1,CENTER('EXCLUSIVE ACCESS REQUIRED TO' |
  822.              & 'REBUILD KEYS FOR PURC_ORD',80))
  823.         ASK
  824.         RETURN
  825.       ELSE
  826.         BUILD(PURC_ORD)
  827.         CLOSE(PURC_ORD)
  828.         SHARE(PURC_ORD)
  829.         SETHUE(7,0)
  830.         BLANK(25,1,1,80)
  831.       .
  832.     OF 2
  833.       CREATE(PURC_ORD)
  834.       CLOSE(PURC_ORD)
  835.       SHARE(PURC_ORD)
  836.     ELSE
  837.       LOOP
  838.         STOP('Cannot Share PURC_ORD - Error: ' & ERROR())
  839.       .
  840.   . .
  841.  
  842.   SHOW(25,1,CENTER('SHARING FILE: ' & 'ITEM_PO',80))
  843.   SHARE(ITEM_PO)
  844.   IF ERROR()
  845.     CASE ERRORCODE()
  846.     OF 46
  847.       SETHUE(0,7)
  848.       SHOW(25,1,CENTER('REBUILDING KEY FILES FOR ITEM_PO',80))
  849.       OPEN(ITEM_PO)
  850.       IF ERROR()
  851.         SHOW(25,1,CENTER('EXCLUSIVE ACCESS REQUIRED TO' |
  852.              & 'REBUILD KEYS FOR ITEM_PO',80))
  853.         ASK
  854.         RETURN
  855.       ELSE
  856.         BUILD(ITEM_PO)
  857.         CLOSE(ITEM_PO)
  858.         SHARE(ITEM_PO)
  859.         SETHUE(7,0)
  860.         BLANK(25,1,1,80)
  861.       .
  862.     OF 2
  863.       CREATE(ITEM_PO)
  864.       CLOSE(ITEM_PO)
  865.       SHARE(ITEM_PO)
  866.     ELSE
  867.       LOOP
  868.         STOP('Cannot Share ITEM_PO - Error: ' & ERROR())
  869.       .
  870.   . .
  871.  
  872.   SHOW(25,1,CENTER('SHARING FILE: ' & 'PAYMETHD',80))
  873.   SHARE(PAYMETHD)
  874.   IF ERROR()
  875.     CASE ERRORCODE()
  876.     OF 46
  877.       SETHUE(0,7)
  878.       SHOW(25,1,CENTER('REBUILDING KEY FILES FOR PAYMETHD',80))
  879.       OPEN(PAYMETHD)
  880.       IF ERROR()
  881.         SHOW(25,1,CENTER('EXCLUSIVE ACCESS REQUIRED TO' |
  882.              & 'REBUILD KEYS FOR PAYMETHD',80))
  883.         ASK
  884.         RETURN
  885.       ELSE
  886.         BUILD(PAYMETHD)
  887.         CLOSE(PAYMETHD)
  888.         SHARE(PAYMETHD)
  889.         SETHUE(7,0)
  890.         BLANK(25,1,1,80)
  891.       .
  892.     OF 2
  893.       CREATE(PAYMETHD)
  894.       CLOSE(PAYMETHD)
  895.       SHARE(PAYMETHD)
  896.     ELSE
  897.       LOOP
  898.         STOP('Cannot Share PAYMETHD - Error: ' & ERROR())
  899.       .
  900.   . .
  901.  
  902.   SHOW(25,1,CENTER('SHARING FILE: ' & 'TERMS',80))
  903.   SHARE(TERMS)
  904.   IF ERROR()
  905.     CASE ERRORCODE()
  906.     OF 46
  907.       SETHUE(0,7)
  908.       SHOW(25,1,CENTER('REBUILDING KEY FILES FOR TERMS',80))
  909.       OPEN(TERMS)
  910.       IF ERROR()
  911.         SHOW(25,1,CENTER('EXCLUSIVE ACCESS REQUIRED TO' |
  912.              & 'REBUILD KEYS FOR TERMS',80))
  913.         ASK
  914.         RETURN
  915.       ELSE
  916.         BUILD(TERMS)
  917.         CLOSE(TERMS)
  918.         SHARE(TERMS)
  919.         SETHUE(7,0)
  920.         BLANK(25,1,1,80)
  921.       .
  922.     OF 2
  923.       CREATE(TERMS)
  924.       CLOSE(TERMS)
  925.       SHARE(TERMS)
  926.     ELSE
  927.       LOOP
  928.         STOP('Cannot Share TERMS - Error: ' & ERROR())
  929.       .
  930.   . .
  931.  
  932.   SHOW(25,1,CENTER('SHARING FILE: ' & 'VENDORS',80))
  933.   SHARE(VENDORS)
  934.   IF ERROR()
  935.     CASE ERRORCODE()
  936.     OF 46
  937.       SETHUE(0,7)
  938.       SHOW(25,1,CENTER('REBUILDING KEY FILES FOR VENDORS',80))
  939.       OPEN(VENDORS)
  940.       IF ERROR()
  941.         SHOW(25,1,CENTER('EXCLUSIVE ACCESS REQUIRED TO' |
  942.              & 'REBUILD KEYS FOR VENDORS',80))
  943.         ASK
  944.         RETURN
  945.       ELSE
  946.         BUILD(VENDORS)
  947.         CLOSE(VENDORS)
  948.         SHARE(VENDORS)
  949.         SETHUE(7,0)
  950.         BLANK(25,1,1,80)
  951.       .
  952.     OF 2
  953.       CREATE(VENDORS)
  954.       CLOSE(VENDORS)
  955.       SHARE(VENDORS)
  956.     ELSE
  957.       LOOP
  958.         STOP('Cannot Share VENDORS - Error: ' & ERROR())
  959.       .
  960.   . .
  961.  
  962.   SHOW(25,1,CENTER('SHARING FILE: ' & 'SALESPER',80))
  963.   SHARE(SALESPER)
  964.   IF ERROR()
  965.     CASE ERRORCODE()
  966.     OF 46
  967.       SETHUE(0,7)
  968.       SHOW(25,1,CENTER('REBUILDING KEY FILES FOR SALESPER',80))
  969.       OPEN(SALESPER)
  970.       IF ERROR()
  971.         SHOW(25,1,CENTER('EXCLUSIVE ACCESS REQUIRED TO' |
  972.              & 'REBUILD KEYS FOR SALESPER',80))
  973.         ASK
  974.         RETURN
  975.       ELSE
  976.         BUILD(SALESPER)
  977.         CLOSE(SALESPER)
  978.         SHARE(SALESPER)
  979.         SETHUE(7,0)
  980.         BLANK(25,1,1,80)
  981.       .
  982.     OF 2
  983.       CREATE(SALESPER)
  984.       CLOSE(SALESPER)
  985.       SHARE(SALESPER)
  986.     ELSE
  987.       LOOP
  988.         STOP('Cannot Share SALESPER - Error: ' & ERROR())
  989.       .
  990.   . .
  991.  
  992.   SHOW(25,1,CENTER('SHARING FILE: ' & 'PAYMENTS',80))
  993.   SHARE(PAYMENTS)
  994.   IF ERROR()
  995.     CASE ERRORCODE()
  996.     OF 46
  997.       SETHUE(0,7)
  998.       SHOW(25,1,CENTER('REBUILDING KEY FILES FOR PAYMENTS',80))
  999.       OPEN(PAYMENTS)
  1000.       IF ERROR()
  1001.         SHOW(25,1,CENTER('EXCLUSIVE ACCESS REQUIRED TO' |
  1002.              & 'REBUILD KEYS FOR PAYMENTS',80))
  1003.         ASK
  1004.         RETURN
  1005.       ELSE
  1006.         BUILD(PAYMENTS)
  1007.         CLOSE(PAYMENTS)
  1008.         SHARE(PAYMENTS)
  1009.         SETHUE(7,0)
  1010.         BLANK(25,1,1,80)
  1011.       .
  1012.     OF 2
  1013.       CREATE(PAYMENTS)
  1014.       CLOSE(PAYMENTS)
  1015.       SHARE(PAYMENTS)
  1016.     ELSE
  1017.       LOOP
  1018.         STOP('Cannot Share PAYMENTS - Error: ' & ERROR())
  1019.       .
  1020.   . .
  1021.  
  1022.   RECOVER()                                      !DISARM RECOVER
  1023. ! BLANK                                          !BLANK THE SCREEN
  1024.  
  1025.  
  1026.  
  1027.              SOURCE
  1028.  
  1029. !---------------- Eckenroed & Associates 02-90 -----------------------
  1030. !
  1031. !                    REPORT3.LEM for use with CLARION batch 2010
  1032. !
  1033. !   This file contains the procedures used to show a report on the screen
  1034. !   and allow a user to preview it be for printing or saving as a file.
  1035. !
  1036. !     ROUTE_FILE - Main controller.  routes report to screen, disk, printer
  1037. !     SHOW_fILE - Opens a screen for the file and calls SHOWTEXT
  1038. !     GET_FILENAME - prompts the user to enter a vaild DOS file name
  1039. !     GET_CPY - Prompts the user to enter the number of copies to be printed
  1040. !     PRINTR_READY - Function that checks the printer to see if it is ready.
  1041. !
  1042. !            copyright 1990 by Eckenroed & Associates, Boise, Idaho
  1043. !---------------------------------------------------------------------
  1044.  
  1045. !═══════════════════════════════════════════════════════════════════════════════
  1046. ROUTE_FILE   PROCEDURE(INPUT_FILE)
  1047.  
  1048. !---------------------------------------------------------------------
  1049. !   copyright 1990 by Eckenroed & Associates, Boise, Idaho
  1050. !---------------------------------------------------------------------
  1051.  
  1052. INPUT_FILE   STRING(78)                          !INPUT FILE TO SHOW
  1053.  
  1054. SCREEN       SCREEN       WINDOW(7,47),PRE(SCR),HLP('ROUTE'),HUE(0,3)
  1055.                ROW(1,1)   STRING('╔═{45}╗')
  1056.                ROW(2,1)   REPEAT(3);STRING('║<0{45}>║') .
  1057.                ROW(5,1)   STRING('╟─{45}╢')
  1058.                ROW(6,1)   STRING('║<0{45}>║')
  1059.                ROW(7,1)   STRING('╚═{45}╝')
  1060.                ROW(3,6)   STRING('Send report to:')
  1061.                  COL(29)  STRING(',')
  1062.                  COL(38)  STRING(',')
  1063.                ROW(6,3)   STRING('F1')
  1064.                  COL(6)   STRING('Help')
  1065.                  COL(38)  STRING('ESC')
  1066.                  COL(42)  STRING('Quit')
  1067.                ROW(2,7)   ENTRY,USE(?FIRST_FIELD)
  1068.                ROW(4,8)   MENU(@S35),USE(?MENU_FIELD),HUE(4,3),SEL(4,3)
  1069.                ROW(3,23)    STRING('Screen'),HUE(0,3),SEL(11,0)                   |
  1070.                               DESC('Send Report to Screen for Viewing')
  1071.                  COL(31)    STRING('Printer'),HUE(0,3),SEL(11,0)                  |
  1072.                               DESC(' Print the Report on the Printer')
  1073.                  COL(40)    STRING('Disk'),HUE(0,3),SEL(11,0)                     |
  1074.                               DESC('   Print the report to a file')
  1075.              .            .
  1076. BINARY       DOS,NAME(INPUT_FILE)                ! FILE TO DISPLAY
  1077.              RECORD
  1078. BINREC       STRING(255)
  1079.              . .
  1080.  
  1081. PRINTER      DOS,NAME(r3m:lpt)
  1082.              RECORD
  1083. PRTREC       STRING(255)
  1084.              . .
  1085.  
  1086. cancel_msg   group
  1087.              STRING('<13,10,10>')                !skip down 2 lines
  1088.              STRING('((Cancelled))')
  1089.              STRING('<13,10>')
  1090.              STRING('<18>')                      !reset printer to normal
  1091.              STRING('<12>')                      !issue formfeed
  1092.              .
  1093.  
  1094. PRT_SCN      SCREEN       WINDOW(6,38),HUE(1,7)
  1095.                ROW(5,10)  PAINT(1,21),HUE(4,7)
  1096.                ROW(1,1)   STRING('╔═{36}╗')
  1097.                ROW(2,1)   REPEAT(4);STRING('║<0{36}>║') .
  1098.                ROW(6,1)   STRING('╚═{36}╝')
  1099.                ROW(3,12)  STRING('Printing report ....'),BLK
  1100.                ROW(5,10)  STRING('(Press ESC to Cancel)')
  1101.              .
  1102.  
  1103. COPY_SCN     SCREEN       WINDOW(5,38),HUE(1,7)
  1104.                ROW(1,1)   STRING('╔═{36}╗')
  1105.                ROW(2,1)   REPEAT(3);STRING('║<0{36}>║') .
  1106.                ROW(5,1)   STRING('╚═{36}╝')
  1107.                ROW(3,12)  STRING('Printing report ....'),BLK
  1108.              .
  1109. copies       byte
  1110. filename     string(78)
  1111.  
  1112.   code
  1113.   open(screen)
  1114.   select(?menu_field)
  1115.   loop
  1116.     accept
  1117.     case field()
  1118.     of ?first_field
  1119.       remove(BINARY)
  1120.       return
  1121.     of ?menu_field
  1122.       execute choice()
  1123.         do show_file
  1124.         do prnt_file
  1125.         do copy_file
  1126.       .                                          !end execute
  1127.     .                                            !end case
  1128.     select(?menu_field)
  1129.   .                                              !end loop
  1130.  
  1131. show_file    routine
  1132.   show_file(input_file,1)
  1133.  
  1134. prnt_file    routine
  1135.   copies = get_cpy()                             ! get number to print
  1136.   if keycode() = ESC_KEY then exit.
  1137.  
  1138.   if printr_ready()
  1139.   else
  1140.     exit
  1141.   .
  1142.   IF copies < 2 THEN copies = 1.
  1143.   LOOP copies TIMES
  1144.     OPEN(PRT_SCN)
  1145.     open(BINARY)                                 ! OPEN FILE TO DISPLAY
  1146.     set(BINARY)
  1147.     open(PRINTER)
  1148.     LOOP UNTIL EOF(BINARY)
  1149.       if keyboard()
  1150.         ask()
  1151.         if keycode() = ESC_KEY
  1152.           prtrec = cancel_msg
  1153.           add(PRINTER,size(cancel_msg))
  1154.           close(BINARY)
  1155.           close(PRINTER)
  1156.           remove(BINARY)
  1157.           return
  1158.       ..
  1159.       NEXT(BINARY)
  1160.       prtrec=binrec
  1161.       ADD(PRINTER,bytes(BINARY))                 !print the record
  1162.   . .
  1163.   close(BINARY)
  1164.   close(PRINTER)
  1165.   remove(BINARY)
  1166.   return
  1167.  
  1168. copy_file    routine
  1169.   filename = get_filename()
  1170.   if keycode() = ESC_KEY or keycode() = REJECT_KEY then exit.
  1171.   open(copy_scn)
  1172.   copy(BINARY,FILENAME)
  1173.   close(copy_scn)
  1174.  
  1175.  
  1176. !═══════════════════════════════════════════════════════════════════════════════
  1177. SHOW_FILE    PROCEDURE(INPUT_FILE,SCR_NO)        !SCR_NO: 1=FULL 2=WINDOW
  1178.  
  1179. !---------------------------------------------------------------------
  1180. !   copyright 1989 by Eckenroed & Associates, Boise, Idaho
  1181. !---------------------------------------------------------------------
  1182.  
  1183. input_file   string(78)                          !input file to show
  1184. scr_no       byte                                !1=screen  2=screen2
  1185.  
  1186. SCREEN       SCREEN       WINDOW(25,80),HLP('SHOWFIL'),HUE(0,7)
  1187.                ROW(25,2)  PAINT(1,78),HUE(7,1)
  1188.                ROW(8,26)  STRING('╔═{26}╗'),HUE(1,7)
  1189.                ROW(9,26)  REPEAT(3);STRING('║<0{26}>║'),HUE(1,7) .
  1190.                ROW(12,26) STRING('╚═{26}╝'),HUE(1,7)
  1191.                ROW(25,2)  STRING('<24,25,27,26>'),HUE(14,1)
  1192.                ROW(9,33)  STRING('Please Wait'),HUE(1,7)
  1193.                ROW(11,32) STRING('Reading File...'),HUE(20,7)
  1194.                ROW(25,7)  STRING('Scroll'),ENH
  1195.                  COL(16)  STRING('PGUP'),HUE(14,1)
  1196.                  COL(21)  STRING('Page up'),ENH
  1197.                  COL(31)  STRING('PGDN'),HUE(14,1)
  1198.                  COL(36)  STRING('Page down'),ENH
  1199.                  COL(48)  STRING('END'),HUE(14,1)
  1200.                  COL(52)  STRING('bottom'),ENH
  1201.                  COL(61)  STRING('HOME'),HUE(14,1)
  1202.                  COL(66)  STRING('top'),ENH
  1203.                  COL(72)  STRING('ESC '),HUE(14,1)
  1204.                  COL(76)  STRING('Quit'),ENH
  1205.              .
  1206.  
  1207. SCREEN2      SCREEN       WINDOW(15,67),HLP('SHOWFIL'),HUE(0,3)
  1208.                ROW(6,21)  PAINT(3,26),HUE(1,7)
  1209.                ROW(14,2)  PAINT(1,65),HUE(11,1)
  1210.                ROW(1,1)   STRING('╔═{65}╗'),HUE(15,3)
  1211.                ROW(2,1)   REPEAT(13);STRING('║<0{65}>║'),HUE(15,3) .
  1212.                ROW(15,1)  STRING('╚═{65}╝'),HUE(15,3)
  1213.                ROW(5,20)  STRING('╔═{26}╗'),HUE(1,7)
  1214.                ROW(6,20)  REPEAT(3);STRING('║<0{26}>║'),HUE(1,7) .
  1215.                ROW(9,20)  STRING('╚═{26}╝'),HUE(1,7)
  1216.                ROW(14,18) STRING('<27,18,26>'),HUE(15,1)
  1217.                ROW(6,27)  STRING('Please Wait')
  1218.                ROW(8,26)  STRING('Reading File...'),HUE(20,7)
  1219.                ROW(14,3)  STRING('Movement'),HUE(14,1)
  1220.                  COL(11)  STRING(' '),HUE(15,1)
  1221.                  COL(12)  STRING('Keys:'),HUE(14,1)
  1222.                  COL(17)  STRING(' '),HUE(15,1)
  1223.                  COL(21)  STRING(' Scroll  PgUp  PgDn  Home  End {6}'),HUE(15,1)
  1224.                  COL(57)  STRING('ESC:'),HUE(14,1)
  1225.                  COL(61)  STRING(' Quit '),HUE(15,1)
  1226.              .
  1227. ERRSCN       SCREEN       WINDOW(9,45),AT(7,18),PRE(SCR),HUE(15,4)
  1228.                ROW(1,1)   STRING('╔═{43}╗')
  1229.                ROW(2,1)   REPEAT(7);STRING('║<0{43}>║') .
  1230.                ROW(9,1)   STRING('╚═{43}╝')
  1231.                ROW(3,17)  STRING('**'),HUE(14,4)
  1232.                  COL(20)  STRING('ERROR **'),HUE(14,4)
  1233.                ROW(7,9)   STRING('Press any key to continue...'),HUE(14,4)
  1234. MSG            ROW(5,4)   STRING(40),ENH
  1235.              .
  1236.  
  1237. !---- these parameters specify screen area and color for showtext -----
  1238. !  screen must have at least 3 rows and 10 columns and can't use row 25
  1239.  
  1240. R            SHORT                               !row of top-left corner
  1241. C            SHORT                               !column of top-left corner
  1242. RS           SHORT                               !num of rows down
  1243. CS           SHORT                               !num of columns across
  1244. FG           SHORT                               !forground color
  1245. BG           SHORT                               !background color
  1246.  
  1247.   CODE
  1248.  
  1249.   case scr_no
  1250.   of 2
  1251.      !-- create parameters for small window ----------------
  1252.      open(screen2)
  1253.      r = row(screen2)+1                          !top left corner (row)
  1254.      c = col(screen2)+2                          !top left corner (column)
  1255.      rs = rows(screen2)-3                        !number of rows down
  1256.      cs = cols(screen2)-4                        !number of columns accross
  1257.      fg = forehue(r,c)                           !foreground color
  1258.      bg = backhue(r,c)                           !background color
  1259.  
  1260.   else   !(defualt)
  1261.      !-- create parameters for full screen -----------------
  1262.      open(screen)
  1263.      r = row(screen)                             !top left corner (row)
  1264.      c = col(screen)                             !top left corner (column)
  1265.      rs = rows(screen)-1                         !number of rows down
  1266.      cs = cols(screen)                           !number of columns accross
  1267.      fg = forehue(r,c)                           !foreground color
  1268.      bg = backhue(r,c)                           !background color
  1269.   . !case
  1270.  
  1271.   !--- show the report -----
  1272.   showtext(input_file,r,c,rs,cs,fg,bg)           !show file in the window
  1273.  
  1274.   if error()
  1275.     open(errscn)
  1276.     scr:msg = center(error(),size(scr:msg))      !'bad data' means invalid parmeter
  1277.     ask()
  1278.     close(errscn)
  1279.   . !if
  1280. !═══════════════════════════════════════════════════════════════════════════════
  1281. get_filename FUNCTION
  1282.  
  1283. !---------------------------------------------------------------------
  1284. !   copyright 1989 by Eckenroed & Associates, Boise, Idaho
  1285. !---------------------------------------------------------------------
  1286.  
  1287. SCREEN       SCREEN       WINDOW(6,49),PRE(SCR),HLP('FILENAME'),HUE(0,3)
  1288.                ROW(1,1)   STRING('╔═{47}╗')
  1289.                ROW(2,1)   REPEAT(4);STRING('║<0{47}>║') .
  1290.                ROW(6,1)   STRING('╚═{47}╝')
  1291.                ROW(5,3)   STRING('F1')
  1292.                  COL(6)   STRING('Help')
  1293.                  COL(40)  STRING('ESC')
  1294.                  COL(44)  STRING('Quit')
  1295.                ROW(3,14)  ENTRY,USE(?FIRST_FIELD)
  1296.                  COL(4)   STRING('File Name:')
  1297.                  COL(15)  ENTRY(@S30),USE(FULL_NAME),HUE(0,3),SEL(11,0)
  1298.                ROW(5,14)  PAUSE('Press ENTER to continue'),USE(?PAUSE_FIELD)      |
  1299.                             HUE(4,3)
  1300.                  COL(37)  ENTRY,USE(?LAST_FIELD)
  1301.              .
  1302.  
  1303.  
  1304. full_name    string(78)
  1305.  
  1306.   EJECT
  1307.   CODE
  1308.   OPEN(SCREEN)                                   !OPEN THE SCREEN
  1309.   SETCURSOR                                      !TURN OFF ANY CURSOR
  1310.   DISPLAY                                        !DISPLAY THE FIELDS
  1311.   LOOP                                           !LOOP THRU ALL THE FIELDS
  1312.     ALERT                                        !RESET ALERTED KEYS
  1313.     ALERT(ACCEPT_KEY)                            !ALERT SCREEN ACCEPT KEY
  1314.     ALERT(REJECT_KEY)                            !ALERT SCREEN REJECT KEY
  1315.     ACCEPT                                       !READ A FIELD
  1316.     IF KEYCODE() = REJECT_KEY THEN RETURN('').   !RETURN ON SCREEN REJECT KEY
  1317.     EDIT_RANGE# = FIELD()                        !SET ONE FIELD EDIT RANGE
  1318.     IF KEYCODE() = ACCEPT_KEY                    !ON SCREEN ACCEPT KEY
  1319.       UPDATE                                     !  MOVE ALL FIELDS FROM SCREEN
  1320.       EDIT_RANGE# = FIELDS()                     !  AND EDIT REMAINING FIELDS
  1321.     .                                            !
  1322.     LOOP FIELD# = FIELD() TO EDIT_RANGE#         !EDIT FIELDS IN THE EDIT RANGE
  1323.       CASE FIELD#                                !JUMP TO FIELD EDIT ROUTINE
  1324.       OF ?FIRST_FIELD                            !FROM THE FIRST FIELD
  1325.         IF KEYCODE() = ESC_KEY THEN RETURN('').  !  RETURN ON ESC KEY
  1326.  
  1327.       OF ?full_name                              !Report Device Name
  1328.         if full_name = mem:device
  1329.           select(?)
  1330.           beep
  1331.           cycle
  1332.         .
  1333.         full_name = filevalid(full_name)         !Filevalid returns full path
  1334.         display(?)
  1335.         if error()                               ! and sets error if invalid
  1336.           select(?)                              !Also tries to clean up
  1337.           beep                                   ! filename
  1338.           cycle
  1339.         .
  1340.       OF ?PAUSE_FIELD                            !ON PAUSE FIELD
  1341.         IF KEYCODE() <> ENTER_KEY  |             !IF NOT ENTER KEY
  1342.         AND KEYCODE() <> ACCEPT_KEY              !AND NOT CTRL-ENTER KEY
  1343.           BEEP                                   !  SOUND KEYBOARD ALARM
  1344.           SELECT(?PAUSE_FIELD)                   !  AND STAY ON PAUSE FIELD
  1345.         .
  1346.       OF ?LAST_FIELD                             !FROM THE LAST FIELD
  1347.         ACTION = 0                               !  SET ACTION TO COMPLETE
  1348.         RETURN(full_name)                        !  AND RETURN TO CALLER
  1349.   . . .
  1350.  
  1351. !═══════════════════════════════════════════════════════════════════════════════
  1352.  
  1353.  
  1354. get_cpy      FUNCTION
  1355. !---------------------------------------------------------------------
  1356. !   copyright 1989 by Eckenroed & Associates, Boise, Idaho
  1357. !
  1358. !   Alternative to get_cpy in report39.cla.  This allows LPT# to be
  1359. !   changed and shows the number of pages to print.
  1360. !
  1361. !   To use simpley replace get_cpy in report39.cla with this function
  1362. !---------------------------------------------------------------------
  1363.  
  1364. SCREEN       SCREEN       WINDOW(9,49),PRE(SCR),HLP('GET_CPY2'),HUE(1,7)
  1365.                ROW(1,1)   STRING('╔═{47}╗')
  1366.                ROW(2,1)   REPEAT(5);STRING('║<0{47}>║') .
  1367.                ROW(7,1)   STRING('╟─{47}╢')
  1368.                ROW(8,1)   STRING('║<0{47}>║')
  1369.                ROW(9,1)   STRING('╚═{47}╝')
  1370.                ROW(3,25)  STRING('(1 to 9)')
  1371.                ROW(4,25)  STRING('(')
  1372.                  COL(45)  STRING(')')
  1373.                ROW(6,15)  STRING('(Number of pages:')
  1374.                  COL(35)  STRING(')')
  1375.                ROW(8,3)   STRING('F1 Help')
  1376.                  COL(40)  STRING('ESC Quit')
  1377.                ROW(3,38)  ENTRY,USE(?FIRST_FIELD)
  1378.                  COL(5)   STRING('# of Copies? :')
  1379.                  COL(20)  ENTRY(@N1),USE(COPIES),HUE(1,7),SEL(11,0),INS
  1380.                  ROW(4,5)   STRING('Printer Port :')
  1381.                  COL(20)  MENU(@S4),USE(R3M:LPT),HUE(1,7),SEL(11,0)
  1382.                  COL(26)    STRING('LPT1'),HUE(1,7),SEL(11,0)
  1383.                  COL(31)    STRING('LPT2'),HUE(1,7),SEL(11,0)
  1384.                  COL(36)    STRING('LPT3'),HUE(1,7),SEL(11,0)
  1385.                  COL(41)    STRING('LPT4'),HUE(1,7),SEL(11,0)
  1386.                           .
  1387. PAGES          ROW(6,32)  STRING(@N3)
  1388.                ROW(8,14)  PAUSE('Press ENTER to Continue'),USE(?PAUSE),HUE(4,7)
  1389.                ROW(3,28)  ENTRY,USE(?LAST_FIELD)
  1390.              .
  1391. COPIES       BYTE
  1392.  
  1393.   EJECT
  1394.   CODE
  1395.   OPEN(SCREEN)                                   !OPEN THE SCREEN
  1396.   SETCURSOR                                      !TURN OFF ANY CURSOR
  1397.   copies = 1                                     !set default number
  1398.   DISPLAY                                        !DISPLAY THE FIELDS
  1399.   LOOP                                           !LOOP THRU ALL THE FIELDS
  1400.     scr:pages = r3m:pages * copies
  1401.     ALERT                                        !RESET ALERTED KEYS
  1402.     ALERT(ACCEPT_KEY)                            !ALERT SCREEN ACCEPT KEY
  1403.     ALERT(REJECT_KEY)                            !ALERT SCREEN REJECT KEY
  1404.     ACCEPT                                       !READ A FIELD
  1405.     IF KEYCODE() = REJECT_KEY THEN RETURN(0).    !RETURN ON SCREEN REJECT KEY
  1406.     EDIT_RANGE# = FIELD()                        !SET ONE FIELD EDIT RANGE
  1407.     IF KEYCODE() = ACCEPT_KEY                    !ON SCREEN ACCEPT KEY
  1408.       UPDATE                                     !  MOVE ALL FIELDS FROM SCREEN
  1409.       EDIT_RANGE# = FIELDS()                     !  AND EDIT REMAINING FIELDS
  1410.     .                                            !
  1411.     LOOP FIELD# = FIELD() TO EDIT_RANGE#         !EDIT FIELDS IN THE EDIT RANGE
  1412.       CASE FIELD#                                !JUMP TO FIELD EDIT ROUTINE
  1413.       OF ?FIRST_FIELD                            !FROM THE FIRST FIELD
  1414.         IF KEYCODE() = ESC_KEY THEN RETURN(0).   !  RETURN ON ESC KEY
  1415.  
  1416.       OF ?copies                                 !number of copies to print
  1417.         IF copies = ''                           !IF REQUIRED FIELD IS EMPTY
  1418.           BEEP                                   !  SOUND KEYBOARD ALARM
  1419.           SELECT(?copies)                        !  AND STAY ON THIS FIELD
  1420.           BREAK                                  !
  1421.         .
  1422.         IF ~INRANGE(copies,1,9)                  !IF FIELD IS OUT OF RANGE
  1423.           BEEP                                   !  SOUND KEYBOARD ALARM
  1424.           SELECT(?copies)                        !  AND STAY ON THIS FIELD
  1425.           BREAK                                  !
  1426.         .
  1427.  
  1428.       OF ?LAST_FIELD                             !FROM THE LAST FIELD
  1429.         ACTION = 0                               !  SET ACTION TO COMPLETE
  1430.         RETURN(COPIES)                           !  AND RETURN TO CALLER
  1431.   . . .
  1432.  
  1433. !═════════════════════════════════════════════════════════════════════════════
  1434. printr_ready FUNCTION()   !** Test printer status prior to trying to use it **
  1435. !---------------------------------------------------------------------
  1436. !   This function was adapted from a public domain routine obtained from
  1437. !   the CLARION bulletin board.  This function is being furnished
  1438. !   at no cost.
  1439. !---------------------------------------------------------------------
  1440.  
  1441. screen       SCREEN       WINDOW(9,37),AT(9,23),PRE(scr),HLP('PRNT_ERR'),HUE(7,4)
  1442.                ROW(1,1)   STRING('╔═{35}╗'),ENH
  1443.                ROW(2,1)   REPEAT(5);STRING('║<0{35}>║'),ENH .
  1444.                ROW(7,1)   STRING('╟─{35}╢'),ENH
  1445.                ROW(8,1)   STRING('║<0{35}>║'),ENH
  1446.                ROW(9,1)   STRING('╚═{35}╝'),ENH
  1447.                ROW(2,8)   STRING('PRINTER'),HUE(14,4)
  1448.                  COL(22)  STRING(' '),HUE(30,4)
  1449.                  COL(23)  STRING('NOT'),HUE(14,4)
  1450.                  COL(27)  STRING('READY'),HUE(14,4)
  1451.                ROW(4,5)   STRING('Select Action:'),ENH
  1452.                  COL(26)  STRING('or'),ENH
  1453.                ROW(8,3)   STRING('F1'),HUE(14,4)
  1454.                  COL(6)   STRING('Help'),ENH
  1455.                  COL(26)  STRING('ESC'),HUE(14,4)
  1456.                  COL(30)  STRING('Cancel'),ENH
  1457.                ROW(1,1)   ENTRY,USE(?first_field)
  1458. lpt            ROW(2,16)  STRING(6),HUE(14,4)
  1459.                ROW(6,7)   MENU(@S28),USE(?menu),HUE(14,4),SEL(14,4),REQ,IMM
  1460.                ROW(4,20)    STRING('Retry'),ENH,SEL(1,7)                          |
  1461.                               DESC('Attempt to print the report')
  1462.                  COL(29)    STRING('Cancel'),ENH,SEL(1,7)                         |
  1463.                               DESC('Cancel the report and quit')
  1464.              .            .
  1465.  
  1466.                           !************************ Vars for PrnReady *****
  1467. Registers    GROUP
  1468. AX             SHORT
  1469. BX             SHORT
  1470. CX             SHORT
  1471. DX             SHORT
  1472. SI             SHORT
  1473. DI             SHORT
  1474. DS             SHORT
  1475. ES             SHORT
  1476. INT            BYTE
  1477. FLAGS          SHORT
  1478.              END
  1479.  
  1480. open_win_sw  BYTE
  1481. return_cd    BYTE
  1482. lpt_no       byte
  1483. !────────────────────────────────────────────────────────────────────────────
  1484.              CODE
  1485.   return_cd = 1     !* Assume ok
  1486.   open_win_sw = 1
  1487.  
  1488.   case upper(r3m:lpt)
  1489.   of 'LPT1'
  1490.     lpt_no = 0
  1491.  
  1492.   of 'LPT2'
  1493.     lpt_no = 1
  1494.  
  1495.   of 'LPT3'
  1496.     lpt_no = 2
  1497.  
  1498.   of 'LPT4'
  1499.     lpt_no = 3
  1500.  
  1501.   else                                           !defualt to lpt1
  1502.     lpt_no = 1
  1503.   .
  1504.  
  1505.   loop                                           !main loop
  1506.  
  1507.     clear(Registers)              ! Clear group to zeroes.
  1508.     dx = lpt_no                   ! Select printer: 0 = LPT1, 1 = LPT2, etc
  1509.     ax = 0200H                    ! Printer Status request.
  1510.     int = 17h                     ! ROM-BIOS Printer Services.
  1511.     interrupt(Registers)          ! Call interrupt handler
  1512.  
  1513.     if band(ax,2000h) or (not band(ax,8000h)) or  |
  1514.      band(ax,0100h) or band(ax,0800h)
  1515.       if open_win_sw                             !open window if not already open
  1516.          open(screen)
  1517.          select(?menu)
  1518.       .
  1519.       loop
  1520.         scr:lpt = '(' & upper(r3m:lpt) & ')'
  1521.         accept
  1522.         if field() = ?first_field then return(0).
  1523.         case choice()
  1524.         of 1; open_win_sw = 0; break
  1525.         of 2; return_cd = 0; break
  1526.         . !case choice
  1527.       . !loop
  1528.       if not return_cd then break.
  1529.     else break
  1530.     . !if band
  1531.   . !loop main
  1532.   return(return_cd)
  1533.  
  1534. !═══════════════════════════════════════════════════════════════════════════════
  1535.